home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / FEmod.txt < prev    next >
Encoding:
Text File  |  1995-11-28  |  7.0 KB  |  258 lines  |  [TEXT/MSET]
  1. \ Handles Mops user interface.
  2.  
  3. need    alert
  4.  
  5. \ MOPS_OBJECTS sets up system objects for the Mops development environment.
  6. \ We put it first so that we can tick the exported versions of some words,
  7. \ which have to be referred to by vectors or x-arrays (since a module can
  8. \ only be invoked through an exported word).
  9.  
  10. \ Note: the various things we do below in setting up fWind can't be done
  11. \ by SysInit, since under System 7 fWind doesn't exist until a dictionary
  12. \ is read in, which is later than SysInit time.  But for an installed
  13. \ application which uses fWind, this module won't exist, so we have a
  14. \ separate initialization word AppInit (in file ObjInit) which is called
  15. \ by ObjInit for an installed application.  fWind will then be available
  16. \ from the start, so AppInit does the setting up.
  17.  
  18.  
  19. : MOPS_OBJECTS  { \ left top right bottom -- }
  20.     ['] (about)  -> aboutVec
  21.     fWind?
  22.     IF    classinit: fWind   markalive: fWind
  23.         ['] enFW  ['] disFW        setAct: fWind
  24.         myDoc title: fWind
  25.         ScreenBits  -> bottom  -> right  -> top  -> left
  26.         70 70 right bottom  true  setGrow: fWind
  27.         setContRect: fWind
  28.     THEN  ;
  29.  
  30.  
  31.     string    IMAGENAME            \ Current Mops dictionary image name
  32.     string    APPL_NAME            \ Default appl name for Install
  33.     string    APPL_VERS            \ Ditto version string
  34. 0    value    APPL_SIG            \ Ditto signature
  35.  
  36. \ SAVEBASES marks certain modules as unloaded, but saves their base
  37. \ addresses, without actually unloading them.  RESTOREBASES restores the
  38. \ base  addresses the way they were.  We do this so a dictionary save can
  39. \ be done, yielding a valid dictionary image with the modules marked
  40. \ unloaded, but without our needing to reload these modules afterwards. We
  41. \ also do this when the "Purge Modules" menu item is chosen.  The modules
  42. \ we currently treat this way the modules which hang on to vital information
  43. \ during a run, so can't be unloaded without entering crash territory.
  44. \ If you really want to purge everything, invoke PURGE directly, which
  45. \ will even purge this module, probably with entertaining results.
  46. \ You have been warned.
  47.  
  48. : SAVEBASES    \ ( -- sundry_info )
  49.     kludge: FEmod
  50.     kludge: extrasmod
  51.     kludge: pathsmod
  52.     kludge: windowMod
  53.     kludge: menuMod
  54.     kludge: TEFwindMod  ;
  55.  
  56. : RESTOREBASES    \ ( sundry_info -- )
  57.     unkludge: TEFwindMod
  58.     unkludge: menumod
  59.     unkludge: windowmod
  60.     unkludge: pathsmod
  61.     unkludge: extrasmod
  62.     unkludge: FEmod  ;
  63.  
  64.  
  65.  
  66. \        =========== Menu handlers ===========
  67.  
  68. 1 alert    ABTALRT        ' null 1  put: abtAlrt
  69. 1 alert    NimplAlrt    ' null 1  put: NimplAlrt
  70.  
  71. variable    VERSION        40 allot
  72.  
  73. : (ABOUT)
  74.     50 getString  version  place
  75.     0 0  version count  0 0  0 0  paramText
  76.     128 16  disp: abtAlrt  ;
  77.  
  78. : xNIMPL
  79.     129 cautionAlert  disp: NimplAlrt  ;
  80.  
  81.  
  82. \        =============== File Menu ===============
  83.  
  84.     0    value    CURRVREF
  85. false    value    SAVED?        \ True if dic image saved at least once
  86.     0    value    SAVE_RC        \ I/O return code from dic save
  87.  
  88. : .SAVED
  89.     type# 101 ( Saved: )  getname: ffcb  type  cr  ;
  90.  
  91. : SAVE        \ Takes name from input stream.  Redefinition of SAVE in Files,
  92.             \  adding the call to saveBases and restoreBases, which is
  93.             \  vital since on Macs with SCSI DMA, PAUSE can get called
  94.             \  during the write, which will send an IDLE: to our window,
  95.             \  requiring TEFwindMod to be loaded!
  96.     setname: ffcb
  97.     saveBases  (save)  -> save_rc  restoreBases  \ Note: (save) does a purge
  98.     save_rc  ?error 105  .saved  ;
  99.  
  100. : SAVEDIC
  101.     get: imageName  name: fFcb  currVref  setVref: fFcb
  102.     saveBases  (save)  -> save_rc  restoreBases
  103.     save_rc  ?error 105
  104.     true -> saved?  .saved  ;
  105.  
  106. : STDSAVE        \ save via stdFile
  107.     release: callsMod        \ this is so big that it's better to reclaim
  108.                             \  its mem before calling Standard File
  109.     .cur
  110.     " Save Dictionary As:"  saved? IF  get: imagename  ELSE  myDoc  THEN
  111.     stdPut: fFcb
  112.     IF
  113.         getVref: fFcb  -> currVref
  114.         getName: fFcb  put: imageName
  115.         saveDic
  116. \        get: imageName  title: fWind    \ ## gone for 2.5!
  117.     THEN  ;
  118.  
  119. : DOSAVE        \ Resave current dictionary.
  120.     saved?
  121.     IF    saveDic
  122.     ELSE    myDoc  put: imageName
  123.         stdSave
  124.     THEN  ;
  125.  
  126. : PSETUP        \ page setup
  127.     nimpl  ;
  128.  
  129.  
  130. \        ============= List Menu ===============
  131.  
  132. : doOlist    nimpl  ;
  133. : doClist    nimpl  ;
  134.  
  135.  
  136. \        ============= Show Menu ===============
  137.  
  138. : x.ROOM
  139.     cr
  140.     ." Room in dictionary:              "  room    7 .r  cr
  141.     ." Distance to top of hibase range: "  headroom    7 .r  cr
  142.     ." Total heap (no purge):           "  free    7 .r  cr
  143.     ." Largest block (purge):           "  freeblk    7 .r  cr  ;
  144.  
  145. \        ============= Utilities Menu ===============
  146.  
  147.  
  148. : CHKUTIL    \ ( item# b -- ) check item if boolean is true
  149.     IF        check: utilMen
  150.     ELSE    unCheck: utilMen
  151.     THEN  ;
  152.  
  153. \ false    value    PRECHO?  \ 31Jan94 DBH
  154.  
  155. \ : ?UTILFLGS    1 echo? chkUtil  0 prEcho? chkUtil  ;
  156. : ?UTILFLGS        0 echo? chkUtil ;  \ 31Jan94 DBH
  157.  
  158. \ : PECHO        \ Toggles echo to printer
  159. \    prEcho? not -> prEcho?
  160. \    prEcho? IF  +print  ELSE  -print  drop: printmod  THEN
  161. \    ?utilFlgs  ;
  162.  
  163. : LECHO        \ Toggles echo during loads
  164.     echo? not -> echo?  ?utilFlgs  ;
  165.  
  166.  
  167. : DOPURGE   saveBases  purge  restoreBases  ;
  168.  
  169.  
  170.  
  171. : DISFW
  172.     false -> fWindActive?  ;
  173.  
  174. : ENFW
  175.     true -> fWindActive?  ;
  176.  
  177.  
  178. : NMENU
  179.     lock: menuMod
  180.     xts{  doUndo null doCut doCopy doPaste doClear doSelAll null doPref  }
  181.                                                             3  init: EditMen
  182.  
  183.     getnew: AppleMen  getnew: FileMen  getnew: EditMen
  184.     getnew: ListMen  getnew: ShowMen  getnew: UtilMen
  185.     AppleMen FileMen EditMen ListMen ShowMen UtilMen  6  init: MenuBar
  186.     ?utilFlgs  ;
  187.  
  188.  
  189. \                ============= Edit Menu ===============
  190.  
  191. \ Note: the Edit Menu stuff MUST COME AFTER the definition of Nmenu.  This
  192. \ is because we must set up the menu with the EXPORTED versions of the
  193. \ words doUndo etc.  Because we haven't defined these words here in the module
  194. \ yet, only the exported versions are visible from Nmenu, which is what we
  195. \ want.
  196.  
  197.  
  198. \ Scrap support
  199.  
  200.     string    PARMSTR
  201.     var        THEOFFSET
  202.     handle    SCRAPHDL
  203.  
  204. : DoUndo    nimpl  ;
  205. : doCut        nimpl  ;
  206. : doCopy    nimpl  ;
  207. : doClear    nimpl  ;
  208. : doSelAll    nimpl  ;
  209. : xPref        nimpl  ;
  210.  
  211. : GETSCRAP    \ ( -- len )
  212.     0 0 put: parmStr  handle: parmStr  put: scrapHdl
  213.     0  get: scrapHdl  'type TEXT  addr: theOffset
  214.     call GetScrap
  215.     setSize: parmStr  lock: parmStr  len: parmStr  ;
  216.  
  217. : SCRAPKEY    \ Gets next char from the scrap
  218.  
  219.     len: parmStr
  220.     NIF  key!  unlock: FEmod  13  EXIT  THEN    \ Simulate a terminal CR
  221.     1st: parmStr  1 skip: parmStr  ;
  222.  
  223. : DOPASTE        \ Interprets from the scrap
  224.     lock: FEmod
  225.     getScrap 0<=  ?EXIT
  226.     false -> relocChk?  ['] scrapKey -> key  true -> relocChk?
  227.     sp0 sp!  quit  ;
  228.  
  229.  
  230. \ The following words are called by Install to get and set the default name, version and signature for the current application.  They are initialized to the Mops values, but may be changed at any time.  Note that the first two of these words return a string object, rather than an addr and a length.  This was simpler for Install, and they shouldn't be getting called from anywhere else.
  231.  
  232. : GET_APPL_NAME        appl_name  ;
  233. : GET_APPL_VERS        appl_vers  ;
  234. : GET_APPL_SIG        appl_sig  ;
  235.  
  236. : SET_APPL_NAME        put: appl_name  ;
  237. : SET_APPL_VERS        put: appl_vers  ;
  238. : SET_APPL_SIG        -> appl_sig  ;
  239.  
  240. \ system startup word:
  241.  
  242. : RUN_FE
  243.     keep: FEmod
  244.     mops_objects  openMR  nMenu
  245.     " mops.paths"  getPaths
  246.     " Mops"        put: appl_name
  247.     50 getString    put: appl_vers
  248.     'type MOPS    -> appl_sig
  249.     20 -> sleepticks
  250.     run_TE
  251. ;
  252.  
  253.  
  254. : (REL)
  255.     release: imageName  ;
  256.  
  257. ' (rel)  setrelease
  258.